perm filename REDCOM.AUX[CMP,LSP] blob sn#331924 filedate 1978-01-30 generic text, type T, neo UTF8
00100	(DE ATSOC (U V)
00200		(COND ((NULL V) NIL)
00300			((EQ U (CAAR V)) (CAR V))
00400			(T (ATSOC U (CDR V)))))
00500	
00600	(DE COMPRESS (U) (READLIST U))
00700	
00800	(DE DELETE (U V)
00900		   (COND ((NULL V) NIL)
01000			 ((EQUAL U (CAR V)) (CDR V))
01100			 (T (CONS (CAR V) (DELETE U (CDR V))))))
01200	
01300	(DE GLOBAL (U) (FLAG U (QUOTE GLOBAL)))
01400	
01500	(DE GLOBALP (U) (FLAGP U (QUOTE GLOBAL)))
01600	
01700	(DE FLUID (U) (FLAG U (QUOTE FLUID)))
01800	
01900	(DE UNFLUID (U)
02000	    (MAPC (FUNCTION (LAMBDA (V) (REMPROP V (QUOTE FLUID)))) U))
02100	
02200	(DE FLUIDP (U) (FLAGP U (QUOTE FLUID)))
02300	
02301	(DE LEQ (U V) (OR (LESSP U V) (EQUAL U V)))
02302	
02400	(DE LPRIM (U) (PRINT U))
02500	
02600	(DE PUT (U V W) (PUTPROP U V W))
02700	
02800	(DE FLAGP (U V)  (GET U V))
02900	
03000	(DE FLAG (U V) (MAPC (FUNCTION (LAMBDA (W) (PUT W T V))) U))
03100	
03200	(DF PROGN (/-U)
03300	   (COND ((NULL /-U) NIL) ((NULL (CDR /-U)) (EVAL (CAR /-U)))
03400	    (T (PROG2 (EVAL (CAR /-U)) (EVAL (CONS (QUOTE PROGN) (CDR /-U)))))))
03500	(DE GETD (U)
03600	    ((LAMBDA (V) (COND ((NULL V) NIL) (T (CONS (CAR V) (CADR V)))))
03700	     (GETL U (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO)))))
03800	
03900	(DE CONSTANTP (U) (NUMBERP U))
04000	
04100	(SETQ *MODULE NIL)
04200	
04300	(SETQ DFPRINT* NIL)
04400	
04500	(DE CINIT NIL (PROG2 (GC) (EXCISE T)))
04600	
04700	(DF CMP (L) (COMPILE L))
04800	
04900	(SETQ *R2I NIL)
05000	
05100	(SETQ *ORD NIL)
05200	
05300	(SETQ MAXNARGS 5)
05400	
05500	(SETQ *NOLINKL NIL)
05600	
05700	(SETQ *NOLINKR NIL)
05800	
05900	(SETQ *PLAP T)
06000	
06100	(SETQ *SAVEDEF T)
06200	
06300	(PUT (QUOTE LAP) (QUOTE NEWNAM) (QUOTE LAP10))
06400	
06500	(PUT (QUOTE NOT)
06600	     (QUOTE MACRO)
06700	     (QUOTE (LAMBDA (U) (LIST (QUOTE NULL) (CADR U)))))
06800	
06900	(FLAG (QUOTE (OCTAL DECIMAL)) (QUOTE IGNORE))
07000	
07100	(FLAG (QUOTE (OCTAL DECIMAL)) (QUOTE EVAL))
07200	
07300	(FLAG (QUOTE (GLOBAL REVERSIP SPECIAL UNSPECIAL NOT)) (QUOTE LOSE))
07400	
07500	(DE &COMAPPLY (EXP STATUS) (&COMVAL EXP STATUS))
07600